perm filename LI.SAI[1,ALS] blob
sn#001063 filedate 1972-05-30 generic text, type T, neo UTF8
00010 BEGIN "LISTEN"
00020 DEFINE ⊂="COMMENT"; ⊂ 5/30/72;
00030 ⊂ This is a fast version of LIS.SAI;
00040
00060 REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00070
00080 REQUIRE "PREPAR[SYS,THO]" LOAD_MODULE;
00090 REQUIRE "SIG[1,ALS]" LOAD_MODULE;
00100 FORTRAN REAL PROCEDURE SQRT(REAL X);
00110 FORTRAN REAL PROCEDURE ALOG10(REAL X);
00120 FORTRAN REAL PROCEDURE COS(REAL X);
00130 FORTRAN REAL PROCEDURE SIN(REAL X);
00140 REQUIRE "FFT8X[1,ALS]" LOAD_MODULE;
00150 EXTERNAL FORTRAN PROCEDURE FRXFM(REFERENCE INTEGER M;REFERENCE REAL X,Y);
00160 INTEGER DPPOINT,DPP1,DPP2,DATSHIFT;
00170
00180 EXTERNAL PROCEDURE PREPARE;
00190 EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00200 EXTERNAL PROCEDURE TIMSET;
00210 EXTERNAL REAL PROCEDURE RUNTIM;
00220 EXTERNAL STRING PROCEDURE INCHWL;
00230
00240 DEFINE BPS="12";
00250 DEFINE DATSIZ="1280",BUFEXS="43",BUFSIZ="1323",TABSIZ="7400",LISSIZ="1000",INSIZ="24";
00260 DEFINE BYTE="((ILDB(BPT) LSH 24)%2↑24)";
00270 DEFINE LBYT="ILDB(LBPT)";
00280 DEFINE LBYTE="((ILDB(LBPT) LSH 24)%2↑24)";
00290 DEFINE TBLSIZ="250";
00300
00310 STRING FILEL,FILI,TFILEI,TFILE,FILEI,OPT0,OPT1,OPT2,OPT3;
00320 INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
00330 INTERNAL INTEGER ARRAY TABLES[0:TABSIZ];
00340 INTERNAL INTEGER ARRAY PHLIST,HLIST[00:63];
00350 INTERNAL INTEGER ARRAY LIST[0:LISSIZ];
00360 INTERNAL INTEGER ARRAY FLIST[0:35];
00370 INTEGER ARRAY LFILE[0:'177];
00380 INTERNAL REAL ARRAY A,B,C[0:256];
00390 REAL X,SX;
00400 REAL ARRAY WINDOW[0:256];
00410 INTERNAL INTEGER ARRAY INNAM[0:INSIZ];
00420 INTERNAL INTEGER ARRAY INCNT,INSUB,INDIV,INRAW,INDAT[0:INSIZ];
00430 INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,EOF,IEOF,EOFA,BRK;
00440 INTEGER BPT,BPTFST,BPTSAV,LBPT,SEGCNT,SEGTOT;
00450 INTEGER H,I,J,K,L;
00460 INTERNAL INTEGER M,N,P,RATE,STEPS,INFLAG,FLAG;
00470 INTERNAL INTEGER SEGC,SEGMRK,SEGSAV;
00480 INTERNAL INTEGER INTOT,PONY,HINT,UPCNT,TEACH;
00490 INTERNAL INTEGER I1L,I1H,I2L,I2H,I3L,I3H, INL,INH,NZRNG, FP1L,FP1H,FP2L,FP2H,
00500 ILPB,ILPC, IHPB,IHPC ;
00510 INTERNAL INTEGER NF; ⊂ *** USED IN PREPARE;
00520 INTERNAL INTEGER ARRAY TABLET[0:TBLSIZ];
00530 INTERNAL INTEGER TFLAG;
00540 INTERNAL INTEGER ZEROF,ZEROC;
00550
00560 LABEL START;
00580 STRING READ1,READ2,PREHINT,STEPX,STPMOD;
00590 INTEGER HINCNT,HCOUNT,HINDEX;
00600
00610 INTERNAL PROCEDURE XRTRAN(REAL ARRAY A,B;INTEGER N,EVALUATE);
00620 BEGIN
00630 COMMENT IF EVALUATE IS FALSE THIS INTERNAL PROCEDURE UNSCRAMBLES THE SINGLE VARIATE
00640 COMPLEX TRANSFORM ;
00650 INTEGER K,NK,NH;
00660 REAL AA,AB,BA,BB,RE,IM,CK,SK,DC,DS,R;
00670 NH←N%2; R←3.1415926536/N;
00680 DS←SIN(R); R←-(2*SIN(0.5*R))↑2;
00690 DC←-0.5*R; CK←1.0; SK←0;
00700 IF EVALUATE THEN
00710 BEGIN
00720 CK←-1.0; DC←-DC;
00730 END
00740 ELSE
00750 BEGIN
00760 A[N]←A[0]; B[N]←B[0];
00770 END;
00780 FOR K←0 STEP 1 UNTIL NH DO
00790 BEGIN
00800 NK←N-K;
00810 AA←A[K]+A[NK]; AB←A[K]-A[NK];
00820 BA←B[K]+B[NK]; BB←B[K]-B[NK];
00830 RE←CK*BA+SK*AB; IM←SK*BA-CK*AB;
00840 B[NK]←IM-BB; B[K]←IM+BB;
00850 A[NK]←AA-RE; A[K]←AA+RE;
00860 DC←R*CK+DC; CK←CK+DC;
00870 DS←R*SK+DS; SK←SK+DS;
00880 END;
00890 END "XRTRAN";
00900
00920 COMMENT MACROS;
00930 DEFINE ⊂="COMMENT",CR="'15",LF="'12",FF="'14",TB="'11";
00940 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
00950 DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
00960 DEFINE TIL="STEP 1 UNTIL";
00970 DEFINE BDSK="'10",GPH="'11",DSKO="GPH",HP="'7",HPLIST="'6",MUS="'4",ED="'3";
00980 INTEGER K.,J.; ⊂ USED IN MACROS;
00990 DEFINE ERROR(I)="OUT(TTY,""ERROR""&CVS(I))";
01000 DEFINE ISQRT(I)="(K.←(I)↑0.5)";
01010 DEFINE ODD(I)="((I) MOD 2)", EVEN(I)="¬ODD(I)";
01020 DEFINE ABS(I)="(IF I<0 THEN -I ELSE I)";
01030 DEFINE NONNEG(I)="(IF I<0 THEN 0 ELSE I)";
01040 DEFINE TRACE(N)="OUTSTR(""[""&CVS(N)&""]""(";
01050 DEFINE LTRACE(N)="OUTSTR(CR&LF&""[""&CVS(N)&""]"")";
01060 DEFINE FTRACE(N)=
01070 "BEGIN INTEGER F1,F2; GETFORMAT(F1,F2); SETFORMAT(0,7);
01080 OUTSTR(""[""&CVF(N)&""]""); SETFORMAT(F1,F2) END";
01090 DEFINE DATE="DATIME(""DATE"")", TIME="DATIME(""TIME"")";
01100 DEFINE MOVEADR(ADR,ARRAY)="QUICK_CODE MOVE 11,ARRAY;MOVEM 11,ADR;END";
01110 DEFINE PI="3.141592653",PICON="(PI/180)";
01120 DEFINE INFINITY="'377777777777";
01130 STRING PARMS; ⊂ HOLDS CONTENTS OF PARMFILE;
01140
01150 INTERNAL PROCEDURE SETBR;
01160 BEGIN
01170 SETBREAK(1,CR,LF,"IN");
01180 SETBREAK(2,CR&",",LF&TB&" ","IN");
01190 SETBREAK(3,NULL,NULL,"IN");
01200 SETBREAK(4,CR&TB&" ",LF&",","IN");
01210 SETBREAK(5,CR,LF,"ISP"); ⊂ SKIP CR&LF, KEEP LINE NBR AND TAB;
01220 SETBREAK(6,CR&TB&" ",LF&".,","IN");
01230 SETBREAK(7,NULL,0,"I"); ⊂ TO REMOVE NULL CHARACTERS FROM STRING;
01240 SETBREAK(8, "=←;[("&CR , LF&" ])" , "IN");
01250 SETBREAK(9,NULL,0&" "&CR&LF&TB,"IN"); ⊂ READS ENTIRE FILE, OMITTING LINE
01260 NUMBERS, NULLS, BLANKS, CR`S, LF`S, TB`S;
01270 SETBREAK(10," "&TB&CR,"0123456789"&LF,"IN");
01280 SETBREAK(11,NULL,0,"IN"); ⊂ READS ENTIRE FILE, OMITTING LINE NUMBERS,
01290 AND NULLS;
01300 END "SETBR";
01310
01320
01330 INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
01340 BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
01350 BOOLEAN NF;
01360 LOOKUP(CHAN,FILENAME,NF);
01370 WHILE NF DO
01380 BEGIN
01390 OUTSTR(CR&LF&"Can't find "&FILENAME&". File=");
01400 FILENAME ← INPUT(TTY,1);
01410 LOOKUP(CHAN,FILENAME,NF)
01420 END;
01430 END "LOOKIN";
01440
01450 STRING PROCEDURE HEADER;
01460 BEGIN STRING H1,H2; INTEGER I,J,K;
01470 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; RETURN(PREHINT) END
01480 ELSE WHILE HCOUNT=0 DO BEGIN "XX"
01490 I←LFILE[HINDEX]; K←LDB(POINT(7,I,30)); J←SEGC-K;
01500
01510 IF I=0 THEN BEGIN PREHINT←""; HCOUNT←99; RETURN(PREHINT) END;
01520 IF J ≥ 0 THEN BEGIN "LATCH"
01530 H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
01540 H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
01550 IF EQU(H1,H2) THEN BEGIN PREHINT←H1; HCOUNT←LDB(POINT(5,I,35));
01560 HCOUNT←HCOUNT-J;
01570 HINDEX←HINDEX+1; RETURN(PREHINT); DONE
01580 END
01590 ELSE BEGIN PREHINT←""; HCOUNT←LDB(POINT(5,I,35));
01600 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE;
01610 END;
01620 END "LATCH";
01630 PREHINT←""; RETURN(PREHINT); END "XX";
01640 END "HEADER";
01650
00010 SETBR;
00020 UPCNT←3;
00030 FILEL←"LIST1";
00040 FILEI←"TOO1.DAT[1,THO]"; OPT1←"N"; OPT2←"N"; OPT3←"0"; M←8; INFLAG←0;
00050 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00060 CLOSE(CHAN1);
00070 OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00080 LOOKUP(CHAN1,"TABLES.DAT",0);
00090 ARRYIN(CHAN1,INSUB[0],INSIZ);
00100 ARRYIN(CHAN1,INDIV[0],INSIZ);
00110 ARRYIN(CHAN1,INCNT[0],INSIZ);
00120 ARRYIN(CHAN1,INNAM[0],INSIZ);
00130 ARRYIN(CHAN1,FLIST[0],36);
00140 ARRYIN(CHAN1,PHLIST[0],64);
00150 ARRYIN(CHAN1,HLIST[0],64);
00160 ARRYIN(CHAN1,TABLES[0],TABSIZ);
00170 ARRYIN(CHAN1,TABLET[0],TBLSIZ);
00180
00190 CLOSE(CHAN5); CLOSE(CHAN6);
00200 OPEN(CHAN5,"DSK",'10,10,0,0,0,EOF);
00210 LOOKUP(CHAN5,"SIGLST.DAT",0);
00220 ARRYIN(CHAN5,LIST[0],LISSIZ);
00230 INTOT←WORDIN(CHAN5);
00240 RELEASE(CHAN5);
00250
00260 IF (TFILEI←STRIN("Data file list("&FILEL&") = "))≠"" THEN FILEL←TFILEI;
00270 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,30,BRK,EOFA);
00280 LOOKUP(CHAN5,FILEL,1); EOFA←0;
00290
00300 M←8;
00310 N←2↑M; NF←2*N;
00320 FOR I←0 STEP 1 UNTIL N DO
00330 WINDOW[I]←(1-COS((2*PI*I)/N))/2;
00340
00350 N←2↑M;
00360 STPMOD←STRIN(CRLF&"Should HINTS be listed on scope? (Y or CR) = ");
00370 OUTSTR(CRLF&"Shift DATABUF by WORDS = ");
00380 DATSHIFT←CVD(INCHWL); ⊂ USE TO TEST PHASE SENSITIVITY OF LEARNING;
00390 OUTSTR(CRLF);
00400
00410 START:
00420 WHILE EOFA=0 DO BEGIN "LISTREAD"
00430 HINDEX←21; HCOUNT←HINCNT←0; OPT1←"Y"; OPT2←"N"; STEPX←"Y";
00440 FILEI←INPUT(CHAN5,1);
00450 IF EOFA≠0 THEN BEGIN
00460
00470 CLOSE(CHAN2);
00480 OPEN(CHAN2,"DSK",'10,0,10,0,0,0);
00490 ENTER(CHAN2,"TABLES.SAV",0);
00500 ARRYOUT(CHAN2,INSUB[0],INSIZ);
00510 ARRYOUT(CHAN2,INDIV[0],INSIZ);
00520 ARRYOUT(CHAN2,INCNT[0],INSIZ);
00530 ARRYOUT(CHAN2,INNAM[0],INSIZ);
00540 ARRYOUT(CHAN2,FLIST[0],36);
00550 ARRYOUT(CHAN2,PHLIST[0],64);
00560 ARRYOUT(CHAN2,HLIST[0],64);
00570 ARRYOUT(CHAN2,TABLES[0],TABSIZ);
00580 ARRYOUT(CHAN2,TABLET[0],TBLSIZ);
00590 CLOSE(CHAN2);
00600 OUTSTR("Tables have been saved as TABLES.SAV"&CRLF);
00610
00620 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,30,BRK,EOFA);
00630 LOOKUP(CHAN5,FILEL,1); EOFA←0;
00640
00650 DATSHIFT←DATSHIFT+1; OUTSTR("DATSHIFT now set to "&CVS(DATSHIFT)&CRLF);
00660 DONE;
00670 END;
00680
00690 CLOSE(CHAN4);
00700 OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00710 LOOKIN(CHAN4,FILEI);
00720 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
00730 EOF←0; SEGC←0; SEGCNT←0;
00740 SEGTOT←(LFILE[0]*6)%N; RATE←LFILE[2];
00750
00760 IF RATE=0 THEN RATE←CVD(STRIN("Sampling rate missing. Rate = "));
00770 OUTSTR("Data file "&FILEI&" with "&CVS(SEGTOT)&" half segments"&CRLF);
00780 ⊂ **** SET PARAMETER RANGES
00790 THE PARA LIMITS ARE (DOUBLE CHECK) F1=200/800 F2=700/2050 F3=2000/3200
00800 NP=800/1500 NZRNG=NP+/-500 ?
00810 FP1=1800/3200 FP2=3200/5000 LPE=300/450 HPE=2500/3000 ;
00820 ⊂ *** I2H CHANGED FROM 28 TO 26 ESCAPE HI AMP F3 ;
00830 SX←RATE/N; I1L←200./SX ; I1H←800./SX+.5 ; I2L←700./SX; I2H←2050./SX+.5;
00840 I3L←1950./SX; I3H←3250./SX+.5;
00850 INL←800./SX; INH←1500./SX+.5; NZRNG←500./SX+.5;
00860 FP1L←1800./SX; FP1H←3200./SX; FP2L←3200./SX+.5; FP2H←5000./SX+.5;
00870 ILPB←300./SX; ILPC←450./SX; IHPC←2500./SX; IHPB←3000./SX;
00880 BPTFST←POINT(BPS,DATBUF[0],-1);
00890 IF DATSHIFT>0 THEN
00900 ARRYIN(CHAN4,DATBUF[0],DATSHIFT);
00910 ARRYIN(CHAN4,DATBUF[0],BUFEXS);
00920 SEGMRK←SEGC←K←1;
00930 WHILE EOF=0 DO
00940 BEGIN
00950 IF SEGC>SEGTOT THEN DONE;
00960 ARRYIN(CHAN4,DATBUF[BUFEXS],DATSIZ);
00970
00980 IF EOF≠0 THEN
00990 BEGIN
01000 J←EOF LAND '777777;
01010 FOR I←J STEP 1 UNTIL N-1 DO DATBUF[I]←0;
01020 END;
01030 IF SEGMRK<SEGC+30 THEN BEGIN "FOUND"
01040 K←1;
01050
01060 BPT←BPTFST; SEGSAV←SEGC;
01070 WHILE K≤6*DATSIZ%N DO BEGIN
01080 IF (J←SEGMRK-SEGC)>0 THEN BEGIN
01090 FOR I←1 STEP 1 UNTIL J DO BEGIN
01100 BPT←BPTSAV+42; L←ILDB(BPT); L←ILDB(BPT); BPTSAV←BPT; END;
01110 K←K+J; SEGC←SEGMRK; END;
01120 IF SEGC>SEGTOT THEN DONE;
01130 IF K>6*DATSIZ%N THEN DONE;
01140
01150 BPTSAV←BPT;
01160
01170 I←0; WHILE I≥0 DO BEGIN
01180 READ1←HEADER; IF STPMOD="Y" THEN OUTSTR(" ("&CVS(SEGC)&")"&READ1);
01190 IF READ1="" THEN BEGIN SEGMRK←SEGC+1; DONE END;
01200 J←CVSIX(READ1);
01210 FOR I←0 STEP 1 UNTIL 63 DO BEGIN
01220 IF PHLIST[I]=0 THEN BEGIN SEGMRK←SEGC+1;OUTSTR("Hint not identified for segment "&CVS(SEGC)&CRLF);DONE END;
01230 IF PHLIST[I]=J THEN BEGIN
01240 HINT←H←I;TABLES[2]←HLIST[I] ; DONE ; END;
01250 END;
01260 IF I<64 THEN BEGIN SEGMRK←SEGC+1; DONE END;
01270 END;
01280 IF READ1≠"" THEN BEGIN
01290 HINCNT←HINCNT+1;
01300 J←I←ZEROC←0; A[J]←BYTE*WINDOW[I]; B[J]←BYTE*WINDOW[I+1]; J←J+1;
01310 IF B[J]<A[J] THEN ZEROF←0 ELSE ZEROF←1;
01320 FOR I←2 STEP 2 UNTIL N-1 DO
01330 BEGIN
01340 A[J]←BYTE*WINDOW[I];
01350 IF A[J]<B[J-1] THEN ZEROF←0 ELSE IF ZEROF=0 THEN BEGIN ZEROF←1; ZEROC←ZEROC+1; END;
01360 B[J]←BYTE*WINDOW[I+1];
01370 IF B[J]<A[J] THEN ZEROF←0 ELSE IF ZEROF=0 THEN BEGIN ZEROF←1; ZEROC←ZEROC+1; END;
01380 J←J+1;
01390 END;
01400 FRXFM(M-1,A[0],B[0]);
01410 XRTRAN(A,B,N/2,FALSE);
01420 FOR I←0 STEP 1 UNTIL N/2 DO C[I]←5.*ALOG10(A[I]↑2+B[I]↑2);
01430 END; ⊂ End of first IF READ1="" ;
01440 IF READ1≠"" THEN BEGIN
01450 PREPARE;
01460
01470 SIG(P);
01480 END; ⊂ END of second IF READ1≠"" ;
01490 IF SEGMRK>SEGSAV+6*DATSIZ%N THEN DONE;
01500 END; ⊂ End of WHILE K≤ ;
01510 END "FOUND";
01520 SEGC←SEGSAV+6*DATSIZ%N; K←1;
01530 FOR I←0 STEP 1 UNTIL BUFEXS-1 DO DATBUF[I]←DATBUF[I+DATSIZ];
01540 FOR I←BUFEXS STEP 1 UNTIL BUFSIZ-1 DO DATBUF[I]←0;
01550 END;
01560 CLOSE(CHAN1);
01570 OPEN(CHAN2,"DSK",'10,0,10,0,0,0);
01580 ENTER(CHAN2,"TABLES.DAT",0);
01590 ARRYOUT(CHAN2,INSUB[0],INSIZ);
01600 ARRYOUT(CHAN2,INDIV[0],INSIZ);
01610 ARRYOUT(CHAN2,INCNT[0],INSIZ);
01620 ARRYOUT(CHAN2,INNAM[0],INSIZ);
01630 ARRYOUT(CHAN2,FLIST[0],36);
01640 ARRYOUT(CHAN2,PHLIST[0],64);
01650 ARRYOUT(CHAN2,HLIST[0],64);
01660 ARRYOUT(CHAN2,TABLES[0],TABSIZ);
01670 ARRYOUT(CHAN2,TABLET[0],TBLSIZ);
01680 CLOSE(CHAN2);
01690 IF STPMOD="Y" THEN OUTSTR(CRLF);
01700 OUTSTR("Tables saved. "&CVS(HINCNT)&" hints found."&CRLF);
01710 IF EOFA≠0 THEN DONE;
01720 END "LISTREAD";
01730 GO TO START;
01740 END "LISTEN";